import Prelude
import HUnit

-- El traductor se representa por un conjunto de estados "q",
--   - una funcion de transicion (primer parametro),
--   - una funcion de output (segundo parametro) y
--   - un estado inicial.
type Traductor q = (q -> Char -> q, q -> Char -> String, q)

-- Traductor que cambia las "a"s por "e"s y viceversa.
cambiarAE :: Traductor ()
cambiarAE = (const, g, ())
  where
    g :: () -> Char -> String
    g () 'a' = "e"
    g () 'e' = "a"
    g ()  x  = [x]

-- Traductor que intercambia caracteres consecutivos.
--
-- Se devuelve un traductor en el que tanto f como g
-- se definen utilizando pattern matching sobre el estado
-- que reciben como parámetro, cumpliendo su funcionamiento de
-- a acuerdo a si el estado es Nothing o es un Char.
intercambiarConsecutivos :: Traductor (Maybe Char)
intercambiarConsecutivos = (f, g, Nothing)
  where
    f :: Maybe Char -> Char -> Maybe Char
    f Nothing c = Just c
    f (Just a) c = Nothing
    --
    g :: Maybe Char -> Char -> String
    g Nothing c = [ ]
    g (Just a) c = [c, a]

-- Traductor que sea la identidad, salvo que nunca genera
-- salida output de las "a"s y, cuando aparece una "z",
-- muestra la "z" y luego todas las "a"s que se acumularon
-- juntas.
acumularAes :: Traductor Int
acumularAes = (f, g, 0)
  where
    f :: Int -> Char -> Int
    f x 'a' = x + 1
    f x 'z' = 0
    f x  c  = x
    --
    g :: Int -> Char -> String
    g x 'z' = 'z':(replicate x 'a')
    g x 'a' = [ ]
    g x  c  = [c]

-- Traductor que de vuelta (ie. espeje) todo lo que esta
-- entre dos "a"s consecutivas.
--
-- Se devuelve un traductor en el que tanto f como g
-- se definen utilizando pattern matching sobre el Char
-- que reciben como parámetro, diferenciando su funcionamiento de
-- para el caracter 'a' de los demás.

espejarEntreAs :: Traductor String
espejarEntreAs = (f, g, [])
  where 
    f :: String -> Char -> String
    f s 'a' = []
    f s c = s ++ [c] 
    --
    g :: String -> Char -> String
    g s 'a'  = reverse s ++ ['a']
    g s c  = []
    
-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version recursiva explicita).
fAst' :: (q -> Char -> q) -> q -> String -> q
fAst' f q0    ""  = q0
fAst' f q0 (c:cs) = fAst' f (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
--
-- Se utiliza un fold a izquierda que aplique f sobre
-- los caracteres del string pasados como parametros, tomando
-- como estado inicial q0.
fAst :: (q -> Char -> q) -> q -> String -> q
fAst f q0 xs = foldl f q0 xs

-- Calcular la clausura de Kleene de la funcion de
-- salida pasada como parametro junto con la funcion
-- de transicion pasada como parametro
-- (version recursiva explicita).
gAst' :: (q -> Char -> q) -> (q -> Char -> String) ->
         q -> String -> String
gAst' f g q0    ""  = ""
gAst' f g q0 (c:cs) = (g q0 c) ++ gAst' f g (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de salida
-- pasada como parametro junto con la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
--
-- Se utiliza un fold que recorre el string que tiene como parámetro
-- de izquierda a derecha, devolviendo en cada iteración una función
-- función que toma un estado como parámetro y concatena la aplicación
-- de g al estado y al caracter al string que se viene generando.
gAst :: (q -> Char -> q) -> (q -> Char -> String) ->
        q -> String -> String
gAst f g q s = (foldr (\x rec -> (\estado -> g estado x ++ rec (f estado x))) (const []) s) q 

-- Dado un traductor, retornar la funcion String -> String
-- que resulta al aplicarlo a cualquier entrada
aplicando :: Traductor q -> String -> String
aplicando (f, g, q) = gAst f g q

-- Dados dos traductores, dar un traductor tal que la
-- funcion String -> String que denota el resultado, sea
-- justo la composicion de las funciones de cada
-- uno de los parametros
--
-- La función de transición devuelve una tupla que contiene un nuevo estado,
-- resultado de la aplicacion de la f correspondiente a cada traductor.
-- En el caso del traductor del segundo parámetro se aplica la f para el caracter, mientras
-- que para el primero es necesaria la utilización de fAst ya que la entrada es un String.
--
-- La función g, primero aplica la función g del segundo traductor sobre su estado y
-- el caracter recibido como parámetro y sobre el string que devuelve se aplica
-- gAst tomando las funciones y el estadio inicial correspondiente al primer traductor.
--
-- La utilización de las funciones fAst y gAst permite tener una implementación limpia 
-- que agrega declaratividad al código.
comp :: Traductor qq1 -> Traductor qq2 -> Traductor (qq1, qq2)
comp (fTr1, gTr1, q0Tr1) (fTr2, gTr2, q0Tr2) = (fComp, gComp, (q0Tr1, q0Tr2))
	where
	fComp (q1,q2) c = (fAst fTr1 q1 (gTr2 q2 c), fTr2 q2 c)
	--
	gComp (q1,q2) c = gAst fTr1 gTr1 q1 (gTr2 q2 c)

-- Dado un traductor, dar la cadena infinita que resulta de
-- procesar una lista infinita de "a"s (si se pide
-- "take n (salidaAes t)" no puede procesar infinitamente
-- para ningun "n")
--
-- Se utiliza la función 'aplicando' sobre el traductor y sobre 'listaInfinitaDeAes',
-- función auxiliar definida para el ejercicio. La función 'listaInfinitaDeAes' es una
-- lista infinita generada por comprensión. Esta función aprovecha la evaluación Lazy de Haskell,
-- es posible la utilización de aplicando sobre una lista que se genera de manera infinita.
salidaAes :: Traductor q -> String
salidaAes t = aplicando t listaInfinitaDeAes 
	where
	listaInfinitaDeAes = ['a' | x <- [1..]]

-- Decidir si es posible que el traductor dado de la salida
-- dada como segundo parametro
--
-- Este ejercicio utiliza una función auxiliar, la función 'cadenasNumericasHastaLongitudN' que
-- retorna todas las cadenas posibles de longitud menor o igual a N, siendo estas cadenas las combinaciones posibles de los números naturales incluyendo a las cadenas con cero a la izquierda. El sentido
-- de esta función es que como se tiene la precondición que el traductor no contiene transiciones cuya 
-- traducción resulte en la cadena vacía, el string salida de los traductores de salidaPosible 
-- no puede tener longitud mayor al string entrada. De esta forma alcanza con tomar todos los números
-- naturales que no tienen más dígitos que la longitud del string entrada del traductor.
-- Se aplica la función any sobre la lista de todas las posibles entradas, utilizando como función
-- de comparación la igualdad entre la aplicación del traductor al elemento y el string salida. De esta forma si
-- para algún elemento se cumple la igualdad la función retornará True y retornará False si no se
-- cumple en ningún caso.
-- La función cadenasNumericasHastaLongitudN utiliza 'iterate' para generar los números necesarios, 'map' a 'show'
-- para mapearlos a string, y 'take ( n )' para quedarse sólo con las cadenas de n dígitos.  Aquí también
-- se saca provecho de la evaluación lazy de Haskell.
salidaPosible :: Traductor q -> String -> Bool
salidaPosible t s = any (\elem -> aplicando t elem == s) (cadenasNumericasHastaLongitudN (length s))


cadenasNumericasHastaLongitudN :: Int -> [String]
cadenasNumericasHastaLongitudN n = concat (take n (iterate (foldr (\x rec -> (map (x++) digitos)++rec) []) digitos)) 
digitos = take 10 (map show (iterate (+1) 0))

aplicandoGAst' :: Traductor q -> String -> String
aplicandoGAst' (f, g, q) = gAst' f g q

aplicandoFAst :: Traductor q -> String -> q
aplicandoFAst (f, g, q) = fAst f q

aplicandoFAst' :: Traductor q -> String -> q
aplicandoFAst' (f, g, q) = fAst' f q


-- Casos de test

test_cambiar_a_por_e = TestCase (assertEqual "test cambiar AE" "xaaaeeex" (aplicando cambiarAE "xeeeaaax"))
test_intercambiar_consecutivos = TestCase (assertEqual "test intercambiarConsecutivos" "21sadd" (aplicando intercambiarConsecutivos "12asdd"))
test_espejar_entre_as_1 = TestCase (assertEqual "test espejarEntreAs 1" "123a456aa789a" (aplicando espejarEntreAs "321a654aa987a"))
test_espejar_entre_as_2 = TestCase (assertEqual "test espejarEntreAs 2" "7654321a" (aplicando espejarEntreAs "1234567a"))
test_comp_1 = TestCase (assertEqual "test comp cambiarAE intercambiarConsecutivos" "21be43dc65fa" (aplicando (comp cambiarAE intercambiarConsecutivos) "12ab34cd56ef"))
test_comp_2 = TestCase (assertEqual "test comp acumularAes cambiarAE" "xxxxxzaaax" (aplicando (comp acumularAes cambiarAE) "xxxeeexxzx"))
test_salidaAes_1 = TestCase (assertEqual "test salidaAes cambiarAE" "eeeeee" (take 6 (salidaAes cambiarAE)))
test_salidaAes_2 = TestCase (assertEqual "test salidaAes intercambiarConsecutivos" "aaaaaa" (take 6 (salidaAes intercambiarConsecutivos)))
test_salida_posible_1 = TestCase (assertEqual "test salidaPosible cambiarAE 1" True  (salidaPosible cambiarAE "1234"))
test_salida_posible_2 = TestCase (assertEqual "test salidaPosible cambiarAE 2" False  (salidaPosible cambiarAE "abcd"))
test_gastp_vs_gast = TestCase (assertEqual "test gAst' = gAst" (aplicandoGAst' cambiarAE "aeees") (aplicando cambiarAE "aeees"))
test_fastp_vs_fast = TestCase (assertEqual "test fAst' = fAst" (aplicandoFAst' acumularAes "aaxezxx") (aplicandoFAst acumularAes "aaxezxx"))

main = do runTestTT test_cambiar_a_por_e
          runTestTT test_intercambiar_consecutivos
          runTestTT test_espejar_entre_as_1
          runTestTT test_espejar_entre_as_2
          runTestTT test_comp_1
          runTestTT test_comp_2
          runTestTT test_salidaAes_1
          runTestTT test_salidaAes_2
          runTestTT test_salida_posible_1
          runTestTT test_salida_posible_2
          runTestTT test_gastp_vs_gast
          runTestTT test_fastp_vs_fast

